home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / e / amigae33a.lha / E_v3.3a / Src.lha / Src / Utils / FindString13.e < prev    next >
Text File  |  1997-05-12  |  10KB  |  361 lines
  1. OPT OSVERSION=37
  2.  
  3. MODULE 'tools/async',
  4.        'tools/ctype',
  5.        'tools/easygui',
  6.        'amigalib/lists',
  7.        'dos/dos',
  8.        'exec/lists',
  9.        'exec/nodes',
  10.        'intuition/intuition',
  11.        'libraries/asl',
  12.        'asl'
  13.  
  14. ENUM ERR_NONE, ERR_ADOS, ERR_ASL, ERR_EXAM, ERR_EXNEXT, ERR_GUI,
  15.      ERR_LIB, ERR_LOCK, ERR_OPEN, ERR_PATT, ERR_QUIT, ERR_STOP,
  16.      ERR_STR, NUM_ERRS
  17.  
  18. RAISE ERR_ADOS  IF AllocDosObject()=NIL,
  19.       ERR_ASL   IF AllocAslRequest()=NIL,
  20.       ERR_EXAM  IF Examine()=FALSE,
  21.       ERR_LIB   IF OpenLibrary()=NIL,
  22.       ERR_LOCK  IF Lock()=NIL,
  23.       ERR_PATT  IF ParsePattern()=-1,
  24.       ERR_PATT  IF ParsePatternNoCase()=-1,
  25.       ERR_STR   IF String()=NIL
  26.  
  27. CONST MAXSTR=100, BUFFERSIZE=1000
  28.  
  29. CONST MAXPATT=MAXSTR*2+2
  30.  
  31. -> String gadgets
  32. DEF xfindstr[MAXSTR]:STRING, xdirstr[MAXSTR]:STRING,
  33.     findstr[MAXSTR]:STRING, dirstr[MAXSTR]:STRING,
  34.     findgad, dirgad,
  35.     xfpattstr[MAXSTR]:STRING, fpattstr[MAXSTR]:STRING, fpattgad,
  36.     fpattbuff[MAXPATT]:STRING
  37.  
  38. -> Other gadgets
  39. DEF reslist=NIL:PTR TO lh, resgad, gogad,
  40.     xrec=TRUE, xcase=TRUE, xword=FALSE, xbrief=FALSE,
  41.     rec, case, word, brief,
  42.     xpatt=FALSE, patt, pattbuff[MAXPATT]:STRING
  43.  
  44. -> Other globals
  45. DEF ready=TRUE, gh=NIL:PTR TO guihandle, path[MAXSTR]:STRING,
  46.     findfunc=NIL, freq=NIL:PTR TO filerequester
  47.  
  48. PROC main() HANDLE
  49.   StrCopy(xfpattstr, '#?')
  50.   newList(NEW reslist)
  51.   easyguiA({prog},
  52.            [EQROWS,
  53.               findgad:=[STR,{s_ignore},'_Find:',xfindstr,MAXSTR,10,0,0,"f"],
  54.               [COLS,
  55.                  [SPACEH],
  56.                  [CHECK,{c_patt},'P_attern?',xpatt,TRUE,0,"a"],
  57.                  [CHECK,{c_case},'_Case sensitive?',xcase,TRUE,0,"c"],
  58.                  [CHECK,{c_word},'_Whole word?',xword,TRUE,0,"w"]
  59.               ],
  60.               [BAR],
  61.               [COLS,
  62.                  dirgad:=[STR,{s_ignore},'_Directory:',xdirstr,MAXSTR,10,0,0,"d"],
  63.                  [BUTTON,{b_pick},'Pic_k...',0,"k"]
  64.               ],
  65.               [COLS,
  66.                  fpattgad:=[STR,{s_ignore},'File _Pattern:',xfpattstr,MAXSTR,5,0,0,"p"],
  67.                  [CHECK,{c_rec},'_Recursive?',xrec,TRUE,0,"r"],
  68.                  [CHECK,{c_brief},'_Brief output?',xbrief,TRUE,0,"b"]
  69.               ],
  70.               [BAR],
  71.               [TEXT,'Results:',NIL,FALSE,5],
  72.               resgad:=[LISTV,{l_ignore},'',25,10,reslist,FALSE,0,0],
  73.               [BAR],
  74.               [COLS,
  75.                  [SPACEH],
  76.                  gogad:=[BUTTON,{b_go},'_GO!',0,"g",0,FALSE],
  77.                  [SPACEH],
  78.                  [BUTTON,{b_stop},'_Stop',0,"s"],
  79.                  [SPACEH],
  80.                  [BUTTON,{b_quit},'_Quit',0,"q"],
  81.                  [SPACEH]
  82.               ]
  83.            ],
  84.            [EG_GHVAR,{gh}, NIL])
  85. EXCEPT DO
  86.   IF reslist
  87.     freeNodes(reslist)
  88.     END reslist
  89.   ENDIF
  90.   IF freq THEN FreeAslRequest(freq)
  91.   IF aslbase THEN CloseLibrary(aslbase)
  92. ENDPROC
  93.  
  94. PROC s_ignore(info, str) IS 0
  95. PROC l_ignore(info, x) IS 0
  96.  
  97. -> Action functions for option gadgets
  98. PROC c_case(info,bool) IS xcase:=bool
  99. PROC c_word(info,bool) IS xword:=bool
  100. PROC c_rec(info,bool) IS xrec:=bool
  101. PROC c_brief(info,bool) IS xbrief:=bool
  102. PROC c_patt(info,bool) IS xpatt:=bool
  103.  
  104. PROC b_pick(info)
  105.   IF aslbase=NIL
  106.     aslbase:=OpenLibrary('asl.library', 37)
  107.     -> Only initialise once so position, path, etc. remembered.
  108.     freq:=AllocAslRequest(ASL_FILEREQUEST,
  109.                          [ASLFR_WINDOW,      gh.wnd,
  110.                           ASLFR_TITLETEXT,   'Pick a Directory',
  111.                           ASLFR_DRAWERSONLY, TRUE,
  112.                           NIL])
  113.   ENDIF
  114.   IF RequestFile(freq) THEN setstr(gh, dirgad, freq.drawer)
  115. ENDPROC
  116.  
  117. PROC b_go(info)
  118.   -> Only go if not already going!
  119.   IF ready
  120.     ready:=FALSE
  121.     go()
  122.     ready:=TRUE
  123.   ENDIF
  124. ENDPROC
  125.  
  126. PROC b_stop(info)
  127.   -> Interrupt if going
  128.   IF ready=FALSE THEN Raise(ERR_STOP)
  129. ENDPROC
  130.  
  131. PROC b_quit(info) IS Raise(ERR_QUIT)
  132.  
  133. -> Copy current gadget values.
  134. PROC copygadgets()
  135.   -> Extract the current strings from the text gadgets.
  136.   getstr(gh,findgad); getstr(gh,dirgad)
  137.   StrCopy(findstr, xfindstr); StrCopy(dirstr, xdirstr)
  138.   rec:=xrec; case:=xcase; word:=xword; brief:=xbrief
  139.   getstr(gh,fpattgad)
  140.   StrCopy(fpattstr, xfpattstr)
  141.   patt:=xpatt
  142. ENDPROC
  143.  
  144. -> Just scan the selected directory.
  145. PROC go() HANDLE
  146.   DEF tmp[MAXSTR]:STRING, p
  147.   setdisabled(gh,gogad)
  148.   -> Get a copy of current gadget values.
  149.   copygadgets()
  150.   -> Not much to do if the string is empty...
  151.   IF EstrLen(findstr)=0 THEN Raise()
  152.   -> Empty the list and redisplay it.
  153.   setlistvlabels(gh, resgad, -1)
  154.   freeNodes(reslist)
  155.   setlistvlabels(gh, resgad, reslist)
  156.   IF patt
  157.     p:=IF word THEN '((#?[~A-Za-z0-9])|%)' ELSE '#?'
  158.     StrCopy(tmp, p); StrAdd(tmp, findstr); StrAdd(tmp, p)
  159.     IF case
  160.       ParsePattern(tmp, pattbuff, MAXPATT)
  161.       findfunc:={find_patt_case}
  162.     ELSE
  163.       ParsePatternNoCase(tmp, pattbuff, MAXPATT)
  164.       findfunc:={find_patt_nocase}
  165.     ENDIF
  166.   ELSEIF case
  167.     findfunc:=IF word THEN {find_word_case} ELSE {find_case}
  168.   ELSE
  169.     -> Make the findstr lowercase if ignoring case differences.
  170.     LowerStr(findstr)
  171.     findfunc:=IF word THEN {find_word_nocase} ELSE {find_nocase}
  172.   ENDIF
  173.   -> Set up pattern buffer.
  174.   ParsePatternNoCase(fpattstr, fpattbuff, MAXPATT)
  175.   scandir(dirstr)
  176. EXCEPT DO
  177.   -> Re-enable the 'Go!' gadget.
  178.   setdisabled(gh,gogad,FALSE)
  179.   IF exception=ERR_QUIT THEN ReThrow()
  180. ENDPROC
  181.  
  182. -> The start of the real work.
  183. PROC scandir(s) HANDLE
  184.   DEF lock=NIL, fib=NIL:PTR TO fileinfoblock, oldlock, len
  185.   len:=EstrLen(path)
  186.   lock:=Lock(s, ACCESS_READ)
  187.   oldlock:=CurrentDir(lock)
  188.   fib:=AllocDosObject(DOS_FIB, NIL)
  189.   -> Examine the file.
  190.   Examine(lock, fib)
  191.   IF fib.direntrytype>=0
  192.     -> It's a directory, so examine all the files it contains.
  193.     WHILE ExNext(lock, fib)
  194.       checkgui(gh)
  195.       IF fib.direntrytype<0
  196.         IF MatchPatternNoCase(fpattbuff, fib.filename)
  197.           scanfile(fib.filename)
  198.         ENDIF
  199.       ELSEIF rec
  200.         -> If directory then call recursively.
  201.         StrAdd(path, fib.filename); StrAdd(path, '/')
  202.         scandir(fib.filename)
  203.         SetStr(path, len)
  204.       ENDIF
  205.     ENDWHILE
  206.     IF IoErr()<>ERROR_NO_MORE_ENTRIES THEN Raise(ERR_EXNEXT)
  207.   ENDIF
  208. EXCEPT DO
  209.   SetStr(path, len)
  210.   IF fib THEN FreeDosObject(DOS_FIB, fib)
  211.   IF lock
  212.     CurrentDir(oldlock)
  213.     UnLock(lock)
  214.   ENDIF
  215.   SELECT NUM_ERRS OF exception
  216.   CASE ERR_ADOS, ERR_EXAM, ERR_EXNEXT, ERR_LOCK
  217.   DEFAULT
  218.     ReThrow()
  219.   ENDSELECT
  220. ENDPROC
  221.  
  222. -> The real work.  Search the file for the findstr.
  223. PROC scanfile(file) HANDLE
  224.   DEF fh=NIL, buffer[BUFFERSIZE]:STRING, line=1
  225.   fh:=myopen(file, OLDFILE)
  226.   WHILE myreadstr(fh, buffer)
  227.     checkgui(gh)
  228.     IF findfunc(buffer)
  229.       report(file, buffer, line)
  230.       -> Stop here if being brief.
  231.       IF brief THEN Raise()
  232.     ENDIF
  233.     INC line
  234.   ENDWHILE
  235. EXCEPT DO
  236.   IF fh THEN myclose(fh)
  237.   IF exception<>ERR_OPEN THEN ReThrow()
  238. ENDPROC
  239.  
  240. -> Use as_Open from tools/async
  241. PROC myopen(file, mode)
  242.   DEF fh
  243.   IF fh:=as_Open(file, mode, 3, 5000)
  244.     RETURN fh
  245.   ELSE
  246.     Raise(ERR_OPEN)
  247.   ENDIF
  248. ENDPROC
  249.  
  250. -> Close the file opened with myopen().
  251. PROC myclose(fh) IS as_Close(fh)
  252.  
  253. -> Return FALSE (or NIL) if failed to read string.
  254. PROC myreadstr(fh, s)
  255.   DEF res
  256.   IF res:=as_FGetS(fh, s, StrMax(s)) THEN SetStr(s, StrLen(s))
  257. ENDPROC res
  258.  
  259. -> Try to find findstr in s (case sensitive)
  260. PROC find_case(s) IS InStr(s, findstr)<>-1
  261.  
  262. -> Try to find the word findstr in s (case sensitive)
  263. PROC find_word_case(s)
  264.   DEF i=0, len
  265.   len:=EstrLen(s)
  266.   WHILE i<len
  267.     IF -1=(i:=InStr(s, findstr, i))
  268.       RETURN FALSE
  269.     ELSEIF isword(s, i, EstrLen(findstr))
  270.       RETURN TRUE
  271.     ELSE
  272.       INC i
  273.     ENDIF
  274.   ENDWHILE
  275. ENDPROC FALSE
  276.  
  277. -> Try to find findstr in s (not case sensitive)
  278. PROC find_nocase(s) IS lower_find(s, {find_case})
  279.  
  280. -> Try to find the word findstr in s (not case sensitive)
  281. PROC find_word_nocase(s) IS lower_find(s, {find_word_case})
  282.  
  283. PROC find_patt_case(s) IS MatchPattern(pattbuff, s)
  284. PROC find_patt_nocase(s) IS MatchPatternNoCase(pattbuff, s)
  285.  
  286. -> Try to find after lowercasing a copy of s.
  287. PROC lower_find(s, real_find)
  288.   DEF tmp[MAXSTR]:STRING
  289.   StrCopy(tmp, s)
  290.   LowerStr(tmp)
  291. ENDPROC real_find(tmp)
  292.  
  293. -> Is the bit between i and i+len a complete word in s?
  294. PROC isword(s, i, len)
  295.   IF i>0 THEN IF isalnum(s[i-1]) THEN RETURN FALSE
  296.   RETURN isalnum(s[i+len])=FALSE
  297. ENDPROC
  298.  
  299. -> Report the find and update list.
  300. PROC report(f, s, n)
  301.   setlistvlabels(gh, resgad, -1)
  302.   addNode(reslist, f, s, n)
  303.   setlistvlabels(gh, resgad, reslist)
  304. ENDPROC
  305.  
  306. -> Add a new node to the list.
  307. PROC addNode(list, f, s, n) HANDLE
  308.   DEF node=NIL:PTR TO ln, len
  309.   NEW node
  310.   len:=EstrLen(path)+StrLen(f)+10
  311.   IF brief
  312.     node.name:=String(len)
  313.     StringF(node.name, '\s\s (\d)', path, f, n)
  314.   ELSE
  315.     filter(s)
  316.     node.name:=String(len+EstrLen(s)+4)
  317.     StringF(node.name, '\s\s (\d) -> \s', path, f, n, s)
  318.   ENDIF
  319.   AddTail(list, node)
  320. EXCEPT
  321.   IF node
  322.     IF node.name THEN DisposeLink(node.name)
  323.     END node
  324.   ENDIF
  325.   ReThrow()
  326. ENDPROC
  327.  
  328. -> Free a list of nodes and empty it.
  329. PROC freeNodes(list:PTR TO lh)
  330.   DEF worknode:PTR TO ln, nextnode
  331.   worknode:=list.head  -> First node.
  332.   WHILE nextnode:=worknode.succ
  333.     IF worknode.name THEN DisposeLink(worknode.name)
  334.     END worknode
  335.     worknode:=nextnode
  336.   ENDWHILE
  337.   newList(list)
  338. ENDPROC
  339.  
  340. -> Convert non-printing chars to " " or ".".
  341. PROC filter(s)
  342.   WHILE s[]
  343.     IF 0=(s[] AND $60)
  344.       SELECT $E OF s[]
  345.       CASE $0
  346.         -> Leave this alone!
  347.       CASE $8, $A, $D
  348.         -> TAB, linefeed, carriage return.
  349.         s[]:=" "
  350.       DEFAULT
  351.         s[]:="."
  352.       ENDSELECT
  353.     ENDIF
  354.     s++
  355.   ENDWHILE
  356. ENDPROC
  357.  
  358.   CHAR 0, '$VER:'
  359. prog:
  360.  CHAR ' FindString 1.3', 0, 0
  361.